home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / programming / emacs-complete / fsf / emacs / src / cmds.c < prev    next >
C/C++ Source or Header  |  1994-08-27  |  11KB  |  409 lines
  1. /* Simple built-in editing commands.
  2.    Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include <config.h>
  22. #include "lisp.h"
  23. #include "commands.h"
  24. #include "buffer.h"
  25. #include "syntax.h"
  26.  
  27. Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function;
  28.  
  29. /* A possible value for a buffer's overwrite-mode variable.  */
  30. Lisp_Object Qoverwrite_mode_binary;
  31.  
  32.  
  33. DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  34.   "Move point right ARG characters (left if ARG negative).\n\
  35. On reaching end of buffer, stop and signal error.")
  36.   (n)
  37.      Lisp_Object n;
  38. {
  39.   if (NILP (n))
  40.     XFASTINT (n) = 1;
  41.   else
  42.     CHECK_NUMBER (n, 0);
  43.  
  44.   /* This used to just set point to point + XINT (n), and then check
  45.      to see if it was within boundaries.  But now that SET_PT can
  46.      potentially do a lot of stuff (calling entering and exiting
  47.      hooks, etcetera), that's not a good approach.  So we validate the
  48.      proposed position, then set point.  */
  49.   {
  50.     int new_point = point + XINT (n);
  51.  
  52.     if (new_point < BEGV)
  53.       {
  54.     SET_PT (BEGV);
  55.     Fsignal (Qbeginning_of_buffer, Qnil);
  56.       }
  57.     if (new_point > ZV)
  58.       {
  59.     SET_PT (ZV);
  60.     Fsignal (Qend_of_buffer, Qnil);
  61.       }
  62.  
  63.     SET_PT (new_point);
  64.   }
  65.  
  66.   return Qnil;
  67. }
  68.  
  69. DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  70.   "Move point left ARG characters (right if ARG negative).\n\
  71. On attempt to pass beginning or end of buffer, stop and signal error.")
  72.   (n)
  73.      Lisp_Object n;
  74. {
  75.   if (NILP (n))
  76.     XFASTINT (n) = 1;
  77.   else
  78.     CHECK_NUMBER (n, 0);
  79.  
  80.   XSETINT (n, - XINT (n));
  81.   return Fforward_char (n);
  82. }
  83.  
  84. DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  85.   "Move ARG lines forward (backward if ARG is negative).\n\
  86. Precisely, if point is on line I, move to the start of line I + ARG.\n\
  87. If there isn't room, go as far as possible (no error).\n\
  88. Returns the count of lines left to move.  If moving forward,\n\
  89. that is ARG - number of lines moved; if backward, ARG + number moved.\n\
  90. With positive ARG, a non-empty line at the end counts as one line\n\
  91.   successfully moved (for the return value).")
  92.   (n)
  93.      Lisp_Object n;
  94. {
  95.   int pos2 = point;
  96.   int pos;
  97.   int count, shortage, negp;
  98.  
  99.   if (NILP (n))
  100.     count = 1;
  101.   else
  102.     {
  103.       CHECK_NUMBER (n, 0);
  104.       count = XINT (n);
  105.     }
  106.  
  107.   negp = count <= 0;
  108.   pos = scan_buffer ('\n', pos2, count - negp, &shortage, 1);
  109.   if (shortage > 0
  110.       && (negp
  111.       || (ZV > BEGV
  112.           && pos != pos2
  113.           && FETCH_CHAR (pos - 1) != '\n')))
  114.     shortage--;
  115.   SET_PT (pos);
  116.   return make_number (negp ? - shortage : shortage);
  117. }
  118.  
  119. DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
  120.   0, 1, "p",
  121.   "Move point to beginning of current line.\n\
  122. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  123. If scan reaches end of buffer, stop there without error.")
  124.   (n)
  125.      Lisp_Object n;
  126. {
  127.   if (NILP (n))
  128.     XFASTINT (n) = 1;
  129.   else
  130.     CHECK_NUMBER (n, 0);
  131.  
  132.   Fforward_line (make_number (XINT (n) - 1));
  133.   return Qnil;
  134. }
  135.  
  136. DEFUN ("end-of-line", Fend_of_line, Send_of_line,
  137.   0, 1, "p",
  138.   "Move point to end of current line.\n\
  139. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  140. If scan reaches end of buffer, stop there without error.")
  141.   (n)
  142.      Lisp_Object n;
  143. {
  144.   register int pos;
  145.   register int stop;
  146.  
  147.   if (NILP (n))
  148.     XFASTINT (n) = 1;
  149.   else
  150.     CHECK_NUMBER (n, 0);
  151.  
  152.   if (XINT (n) != 1)
  153.     Fforward_line (make_number (XINT (n) - 1));
  154.  
  155.   pos = point;
  156.   stop = ZV;
  157.   while (pos < stop && FETCH_CHAR (pos) != '\n') pos++;
  158.   SET_PT (pos);
  159.  
  160.   return Qnil;
  161. }
  162.  
  163. DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
  164.   "Delete the following ARG characters (previous, with negative arg).\n\
  165. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  166. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  167. ARG was explicitly specified.")
  168.   (n, killflag)
  169.      Lisp_Object n, killflag;
  170. {
  171.   CHECK_NUMBER (n, 0);
  172.  
  173.   if (NILP (killflag))
  174.     {
  175.       if (XINT (n) < 0)
  176.     {
  177.       if (point + XINT (n) < BEGV)
  178.         Fsignal (Qbeginning_of_buffer, Qnil);
  179.       else
  180.         del_range (point + XINT (n), point);
  181.     }
  182.       else
  183.     {
  184.       if (point + XINT (n) > ZV)
  185.         Fsignal (Qend_of_buffer, Qnil);
  186.       else
  187.         del_range (point, point + XINT (n));
  188.     }
  189.     }
  190.   else
  191.     {
  192.       call1 (Qkill_forward_chars, n);
  193.     }
  194.   return Qnil;
  195. }
  196.  
  197. DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
  198.   1, 2, "p\nP",
  199.   "Delete the previous ARG characters (following, with negative ARG).\n\
  200. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  201. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  202. ARG was explicitly specified.")
  203.   (n, killflag)
  204.      Lisp_Object n, killflag;
  205. {
  206.   CHECK_NUMBER (n, 0);
  207.   return Fdelete_char (make_number (-XINT (n)), killflag);
  208. }
  209.  
  210. DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
  211.   "Insert the character you type.\n\
  212. Whichever character you type to run this command is inserted.")
  213.   (arg)
  214.      Lisp_Object arg;
  215. {
  216.   CHECK_NUMBER (arg, 0);
  217.  
  218.   /* Barf if the key that invoked this was not a character.  */
  219.   if (XTYPE (last_command_char) != Lisp_Int)
  220.     bitch_at_user ();
  221.   else
  222.     while (XINT (arg) > 0)
  223.       {
  224.     XFASTINT (arg)--;    /* Ok since old and new vals both nonneg */
  225.     internal_self_insert (XINT (last_command_char), XFASTINT (arg) != 0);
  226.       }
  227.  
  228.   return Qnil;
  229. }
  230.  
  231. DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
  232.   "Insert a newline.  With arg, insert that many newlines.\n\
  233. In Auto Fill mode, if no numeric arg, break the preceding line if it's long.")
  234.   (arg1)
  235.      Lisp_Object arg1;
  236. {
  237.   int flag;
  238.   Lisp_Object arg;
  239.   char c1 = '\n';
  240.  
  241.   arg = Fprefix_numeric_value (arg1);
  242.  
  243.   if (!NILP (current_buffer->read_only))
  244.     Fbarf_if_buffer_read_only ();
  245.  
  246.   /* Inserting a newline at the end of a line produces better
  247.      redisplay in try_window_id than inserting at the beginning of a
  248.      line, and the textual result is the same.  So, if we're at
  249.      beginning of line, pretend to be at the end of the previous line.  
  250.  
  251.      We can't use internal_self_insert in that case since it won't do
  252.      the insertion correctly.  Luckily, internal_self_insert's special
  253.      features all do nothing in that case.  */
  254.  
  255.   flag = point > BEGV && FETCH_CHAR (point - 1) == '\n';
  256. #ifdef USE_TEXT_PROPERTIES
  257.   /* We cannot use this optimization if properties change
  258.      in the vicinity.
  259.      ??? We need to check for change hook properties, etc.  */
  260.   if (flag)
  261.     if (! (point - 1 > BEGV && ! property_change_between_p (point - 2, point)))
  262.       flag = 0;
  263. #endif
  264.  
  265.   if (flag)
  266.     SET_PT (point - 1);
  267.  
  268.   while (XINT (arg) > 0)
  269.     {
  270.       if (flag)
  271.     insert (&c1, 1);
  272.       else
  273.     internal_self_insert ('\n', !NILP (arg1));
  274.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  275.     }
  276.  
  277.   if (flag)
  278.     SET_PT (point + 1);
  279.  
  280.   return Qnil;
  281. }
  282.  
  283. /* Insert character C1.  If NOAUTOFILL is nonzero, don't do autofill
  284.    even if it is enabled.
  285.  
  286.    If this insertion is suitable for direct output (completely simple),
  287.    return 0.  A value of 1 indicates this *might* not have been simple.
  288.    A value of 2 means this did things that call for an undo boundary.  */
  289.  
  290. internal_self_insert (c1, noautofill)
  291.      char c1;
  292.      int noautofill;
  293. {
  294.   extern Lisp_Object Fexpand_abbrev ();
  295.   int hairy = 0;
  296.   Lisp_Object tem;
  297.   register enum syntaxcode synt;
  298.   register int c = c1;
  299.   Lisp_Object overwrite;
  300.  
  301.   overwrite = current_buffer->overwrite_mode;
  302.   if (!NILP (Vbefore_change_function) || !NILP (Vafter_change_function)
  303.       || !NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions))
  304.     hairy = 1;
  305.  
  306.   if (!NILP (overwrite)
  307.       && point < ZV
  308.       && (EQ (overwrite, Qoverwrite_mode_binary)
  309.       || (c != '\n' && FETCH_CHAR (point) != '\n'))
  310.       && (EQ (overwrite, Qoverwrite_mode_binary)
  311.       || FETCH_CHAR (point) != '\t'
  312.       || XINT (current_buffer->tab_width) <= 0
  313.       || XFASTINT (current_buffer->tab_width) > 20
  314.       || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
  315.     {
  316.       del_range (point, point + 1);
  317.       hairy = 2;
  318.     }
  319.   if (!NILP (current_buffer->abbrev_mode)
  320.       && SYNTAX (c) != Sword
  321.       && NILP (current_buffer->read_only)
  322.       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
  323.     {
  324.       int modiff = MODIFF;
  325.       Fexpand_abbrev ();
  326.       /* We can't trust the value of Fexpand_abbrev,
  327.      but if Fexpand_abbrev changed the buffer,
  328.      assume it expanded something.  */
  329.       if (MODIFF != modiff)
  330.     hairy = 2;
  331.     }
  332.   if ((c == ' ' || c == '\n')
  333.       && !noautofill
  334.       && !NILP (current_buffer->auto_fill_function)
  335.       && current_column () > XFASTINT (current_buffer->fill_column))
  336.     {
  337.       if (c1 != '\n')
  338.     insert_and_inherit (&c1, 1);
  339.       call0 (current_buffer->auto_fill_function);
  340.       if (c1 == '\n')
  341.     insert_and_inherit (&c1, 1);
  342.       hairy = 2;
  343.     }
  344.   else
  345.     insert_and_inherit (&c1, 1);
  346.   synt = SYNTAX (c);
  347.   if ((synt == Sclose || synt == Smath)
  348.       && !NILP (Vblink_paren_function) && INTERACTIVE)
  349.     {
  350.       call0 (Vblink_paren_function);
  351.       hairy = 2;
  352.     }
  353.   return hairy;
  354. }
  355.  
  356. /* module initialization */
  357.  
  358. syms_of_cmds ()
  359. {
  360.   Qkill_backward_chars = intern ("kill-backward-chars");
  361.   staticpro (&Qkill_backward_chars);
  362.  
  363.   Qkill_forward_chars = intern ("kill-forward-chars");
  364.   staticpro (&Qkill_forward_chars);
  365.  
  366.   Qoverwrite_mode_binary = intern ("overwrite-mode-binary");
  367.   staticpro (&Qoverwrite_mode_binary);
  368.  
  369.   DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function,
  370.     "Function called, if non-nil, whenever a close parenthesis is inserted.\n\
  371. More precisely, a char with closeparen syntax is self-inserted.");
  372.   Vblink_paren_function = Qnil;
  373.  
  374.   defsubr (&Sforward_char);
  375.   defsubr (&Sbackward_char);
  376.   defsubr (&Sforward_line);
  377.   defsubr (&Sbeginning_of_line);
  378.   defsubr (&Send_of_line);
  379.  
  380.   defsubr (&Sdelete_char);
  381.   defsubr (&Sdelete_backward_char);
  382.  
  383.   defsubr (&Sself_insert_command);
  384.   defsubr (&Snewline);
  385. }
  386.  
  387. keys_of_cmds ()
  388. {
  389.   int n;
  390.  
  391.   initial_define_key (global_map, Ctl('M'), "newline");
  392.   initial_define_key (global_map, Ctl('I'), "self-insert-command");
  393.   for (n = 040; n < 0177; n++)
  394.     initial_define_key (global_map, n, "self-insert-command");
  395. #ifdef MSDOS
  396.   for (n = 0200; n < 0240; n++)
  397.     initial_define_key (global_map, n, "self-insert-command");
  398. #endif
  399.   for (n = 0240; n < 0400; n++)
  400.     initial_define_key (global_map, n, "self-insert-command");
  401.  
  402.   initial_define_key (global_map, Ctl ('A'), "beginning-of-line");
  403.   initial_define_key (global_map, Ctl ('B'), "backward-char");
  404.   initial_define_key (global_map, Ctl ('D'), "delete-char");
  405.   initial_define_key (global_map, Ctl ('E'), "end-of-line");
  406.   initial_define_key (global_map, Ctl ('F'), "forward-char");
  407.   initial_define_key (global_map, 0177, "delete-backward-char");
  408. }
  409.